#!/usr/bin/perl -wc

package RFCMail::ESMTP::Server::ReplyTricks;

use strict;
use IO::Handle; # for "reply" and "reply_line" methods

my $PRIVATE = __PACKAGE__;


sub init {
    my $self = shift;
    $self->SUPER::init(@_);
    $self->{$PRIVATE}->{reply_500} = 0
	if defined($self->{reply_max_500});
}


sub ehlo_lines {
    my $self = shift;
    my @ehlo_lines = qw(PIPELINING)
	if defined($self->{reply_no_pipelining}) and not $self->{reply_no_pipelining};
    return (@ehlo_lines, $self->SUPER::ehlo_lines(@_));
}


sub reply {
    my ($self, $reply) = @_;
    my $code = $reply->[0];
    # Promote to 421 if max 500 exceeded
    if (defined($self->{reply_max_500})) {
	if ($code == 500) {
	    $self->{$PRIVATE}->{reply_500}++;
	    $reply = [421, "Too many consecutive syntax errors: closing connection"]
		if $self->{$PRIVATE}->{reply_500} > $self->{reply_max_500};
	}
	else {
	    $self->{$PRIVATE}->{reply_500} = 0;
	}
    }
    # Promote to 421 if data pending and no_pipelining specified
    if ($self->{reply_no_pipelining}) {
	my $blocking = $self->{in_fh}->blocking;
	$self->{in_fh}->blocking(0);
	my $c = $self->{in_fh}->getc;
	if (defined($c)) {
	    $self->{in_fh}->ungetc(ord($c));
	    $reply = [421, "Pipelining not allowed: closing connection"];
	}
	$self->{in_fh}->blocking($blocking);
    }
    $code = $self->SUPER::reply($reply);
    # Delay if desired.
    my $delay_name = "reply_delay_".substr($code, 0, 1)."xx";
    sleep($self->{$delay_name})
	if $self->{$delay_name};
    return ($code);
}


sub reply_lines {
    my $self = shift;
    if ($self->{reply_tarpit}) {
	for (@_) {
	    $self->SUPER::reply_lines($_);
	    sleep($self->{reply_tarpit});
	}
    }
    else {
	$self->SUPER::reply_lines(@_);
    }
}


1;
